home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 7 / BBS in a Box - Macintosh - Volume VII (BBS in a Box) (January 1993).iso / Files / Game / M / MTGOLF.cpt / MTGOLF / MacTour Golf (.txt) < prev    next >
Encoding:
AmigaBASIC Source Code  |  1992-03-23  |  21.9 KB  |  776 lines  |  [MSBC/MSBB]
  1. '                                •••••• MacTour Golf Player ••••••
  2. '                                                      Version 1.0
  3.  
  4. '                                            ©1987 by M. C. Sumner
  5. '                                                23 Anawood Drive
  6. '                                                Arnold, MO 63010
  7.  
  8. 'This program is distributed on a "shareware" basis.  If you enjoy the program
  9. ' ( or make  use of  part of the  code in  another  program )   a  fee   of  $10  is
  10. 'requested.    This  program  should  not  be   duplicated   for  any   publication
  11. 'without  the permission  of the author.    Permission is herein granted for the
  12. 'free distribution of this program via eletronic means (i.e. bulletin boards).
  13.  
  14.  
  15. LIBRARY "ToolLib"
  16. DIM map%(18,26)
  17. DIM green%(65),Tee%(65),TreeICON%(65),ShrubICON%(65)
  18. DIM MapRect%(3),msPt%(1),DispRect%(3,28),ViewRect%(3)
  19. DIM white%(3),Water%(3),Trees%(3),Sand%(3)
  20. DIM Rough%(3),HiRough%(3),fair%(3),bounds%(3)
  21. DIM HitRect1%(3),HitRect2%(3),s$(15)
  22. DIM DirRect%(3),flipRect%(3),BallRect%(3)
  23. DIM MaxDist%(16),loft%(16)
  24. DIM deltax%(27),deltay%(27)
  25. DIM HoleScore%(18)
  26.  
  27. ' The following lines define the patterns used to show terrain types
  28. white%(0)=0:white%(1)=0:white%(2)=0:white%(3)=0
  29. Sand%(0)=2048:Sand%(1)=16386:Sand%(2)=4096:Sand%(3)=320
  30. fair%(0)=-21931:fair%(1)=-21931:fair%(2)=-21931:fair%(3)=-21931
  31. Rough%(0)=-21761:Rough%(1)=-21761:Rough%(2)=-21761:Rough%(3)=-21761
  32. HiRough%(0)=-69:HiRough%(1)=-18:HiRough%(2)=-69:HiRough%(3)=-18
  33. bounds%(0)=-1:bounds%(1)=-1:bounds%(2)=-1:bounds%(3)=-1
  34. Water%(0)=68:Water%(1)=-21999:Water%(2)=68:Water%(3)=-21999
  35. Trees%(0)=60:Trees%(1)=27262:Trees%(2)=31358:Trees%(3)=15360
  36. Shrubs%(0)=8306:Shrubs%(1)=28704:Shrubs%(2)=1038:Shrubs%(3)=19972
  37.  
  38. 'Load patterns into arrays
  39. FOR a%=0 TO 3:curPatn%(a%)=Bound%(a%):NEXT a%
  40.  
  41. 'Load Tree,Shrub,Green, and Tee Icons into arrays
  42. RESTORE IconData
  43. FOR a=0 TO 17:READ green%(a):NEXT a
  44. FOR a=0 TO 17:READ Tee%(a):NEXT a
  45. FOR a=0 TO 65:READ TreeICON%(a):NEXT a
  46. FOR a=0 TO 65:READ ShrubICON%(a):NEXT a
  47.  
  48. 'read in club data
  49. RESTORE ClubData
  50. FOR a%=1 TO 15 : READ MaxDist%(a%) : NEXT a%
  51. FOR a%=1 TO 15 : READ loft%(a%)       : NEXT a%
  52.  
  53. 'Set up menus
  54. MENU 1,0,1,"Game"
  55. MENU 1,1,1,"New Game"
  56. MENU 1,2,1,"Open Game..."
  57. MENU 1,3,0,"Save Game As..."
  58. MENU 1,4,0,"-"
  59. MENU 1,5,1,"Quit"
  60. MENU 3,0,1,"Skill"
  61. MENU 3,1,2,"Begineer"
  62. MENU 3,2,1,"Moderate"
  63. MENU 3,3,1,"Pro"
  64. MENU 4,0,0,""
  65. MENU 5,0,0,""
  66.  
  67. 'About Window (pops up at program start up)
  68. d%=0:b%=0:ms%=0:PtIn%=0:skill%=1
  69. WINDOW 1,"",(40,90)-(450,255),2
  70. CALL <0x0b,0x530d010>(24) 
  71. LOCATE 1,9
  72. PRINT "MacTour Golf"
  73. CALL <0x09,0x530d010>(9)
  74. LOCATE 3,31:PRINT "Version 1.00"
  75. LOCATE 13,13:PRINT "This is a shareware product, see program listing for details."
  76. CALL <0x0a,0x530d010>(12)
  77. CALL <0x20,0x530d010>(165,50):PRINT "By M.C. Sumner"
  78. CALL <0x3c,0x530d010>(80,125):PRINT "Select 'New Game' or 'Open Game' to begin."
  79. LINE (10,60)-(400,60)
  80. LINE (10,62)-(400,64),33,bf
  81. LINE (10,66)-(400,70),33,bf
  82. LINE (10,72)-(400,78),33,bf
  83. LINE (10,80)-(400,88),33,bf
  84. LINE (10,90)-(400,106),33,bf
  85. FOR a=1 TO 3
  86.     PUT (a*32-22,28)-(a*32+9,59),TreeICON%(0)
  87.     PUT (a*32+275,28)-(a*32+306,59),TreeICON%(0)
  88. NEXT a
  89. Hole%=1
  90. MainLoop: 
  91.     m%=MENU(0):i%=MENU(1)
  92.     IF m%=1 AND i%=1 THEN GOSUB NewGame
  93.     IF m%=1 AND i%=2 THEN GOSUB OpenGame
  94.     IF m%=1 AND i%=5 THEN MENU RESET:END
  95.     IF m%=3 THEN GOSUB SetSkill
  96. GOTO MainLoop 
  97.  
  98. 'Open course file to begin new game
  99. NewGame:
  100.     WINDOW CLOSE 1
  101.     Course$=FILES$(1,"MTGC")
  102.     IF LEN(Course$)<1 THEN MENU 1,0,1:RETURN
  103.     OPEN Course$ AS #1 LEN=472
  104.     FIELD #1,1 AS GreenX$,1 AS GreenY$,1 AS TeeX$, 1 AS TeeY$,468 AS HoleMap$
  105.     GOSUB DrawPlayField
  106.     GOSUB GetHole
  107.     Terrain%=1
  108.     GOTO Playhole
  109.  
  110. 'Open game file to restore old game
  111. OpenGame:
  112.     WINDOW CLOSE 1
  113.     Game$=FILES$(1,"MTGG")
  114.     IF LEN(Game$)<1 THEN MENU 1,0,1:RETURN
  115.     OPEN Game$ FOR INPUT AS #2
  116.     INPUT #2,Hole%
  117.     FOR i%=1 TO Hole%-1
  118.         INPUT #2,HoleScore%(i%)
  119.     NEXT i%
  120.     INPUT #2,Course$
  121.     CLOSE #2
  122.     OPEN Course$ AS #1 LEN=472
  123.     FIELD #1,1 AS GreenX$,1 AS GreenY$,1 AS TeeX$, 1 AS TeeY$,468 AS HoleMap$
  124.     GOSUB DrawPlayField
  125.     GOSUB GetHole
  126.     GOSUB Playhole
  127. RETURN
  128.  
  129.  
  130. SaveGame:
  131.    IF Hole%=1 THEN BEEP:BEEP:RETURN
  132.     Game$=FILES$(0,"Save game as:")
  133.     IF LEN(Game$)>0 THEN
  134.         OPEN Game$ FOR OUTPUT AS #2
  135.         PRINT #2,Hole%
  136.         FOR i%=1 TO Hole%-1
  137.             PRINT #2,HoleScore%(i%)
  138.         NEXT i%
  139.         PRINT #2,Course$
  140.         CLOSE #2
  141.         NAME Game$ AS Game$,"MTGG"
  142.     END IF
  143.     GOSUB DrawPlayField
  144.     OldView%=0
  145.     GOSUB GetHole
  146.     GOSUB DrawView
  147. RETURN
  148.  
  149. 'Most action orginates from this routine: direction setting, hitting, etc.  
  150. Playhole:
  151.     CALL <0x13,0x530d010>(VARPTR(flipRect%(0)))
  152.     flip%=NOT flip%
  153.     ms%=MOUSE(0)
  154.     m%=MENU(0)
  155.     i%=MENU(1)
  156.     d%=<0x43,0x530d010>(0):b%=<0x43,0x07>(1)
  157.     IF d%=1 AND b%=1 THEN GOSUB HitBall
  158.     ScrollText s!,scr%(0),s$(0),top%,15,linenum%,4
  159.     IF m%=3 THEN GOSUB SetSkill
  160.     IF m%=1 AND i%=3 THEN GOSUB SaveGame
  161.     IF m%=1 AND i%=5 THEN 
  162.         WINDOW CLOSE 1
  163.         MENU RESET
  164.         END
  165.     END IF
  166.     IF ms%=1 THEN
  167.         GetMouse msPt%(0)
  168.         PtInRect msPt%(0),scr%(0),in%
  169.         IF in% THEN GOSUB ChooseClub
  170.         PtInRect msPt%(0),DirRect%(0),in%
  171.         IF in% THEN GOSUB SetAim
  172.     END IF
  173. GOTO Playhole
  174. RETURN
  175.  
  176. 'actually whack that sucker
  177. HitBall:
  178.     Stroke%=Stroke%+1
  179.     SetRect HitRect2%(0),20,120,36,120
  180.     d%=0 : b%=0 : hit%=0
  181.     WHILE hit%<100 AND d%<>1
  182.         d%=<0x43,0x530d010>(0)
  183.         b%=<0x43,0x530d010>(1) 
  184.         hit%=hit%+1
  185.         LINE (20,120-hit%)-(36,120),33,bf
  186.         IF d%=1 AND b%<>1 THEN d%=0
  187.     WEND
  188.      SetRect HitRect2%(0),20,120-hit%,36,120-hit%
  189.     sink%=120-hit% : d%=0 : b%=0
  190.     IF hit%>20 THEN
  191.         WHILE sink%<120 AND d%<>1
  192.             d%=<0x43,0x530d010>(0)
  193.             b%=<0x43,0x530d010>(1) 
  194.             sink%=sink%+1
  195.             SetRect HitRect2%(0),20,120-hit%,36,sink%
  196.             CALL <0x1f,0x530d010>(VARPTR(HitRect2%(0)),VARPTR(fair%(0)))
  197.             IF d%=1 AND b%<>1 THEN d%=0
  198.         WEND
  199.     END IF
  200.     IF hit%<21 THEN
  201.         sink%=100
  202.         WHILE d%<>1
  203.             d%=<0x43,0x530d010>(0)
  204.         WEND
  205.     END IF
  206.     sink%=100-sink%
  207.     SOUND 110,0.5,200
  208.     a%=1 
  209.     Terrain%=ASC(MID$(Hole$,(x%-1)*26+y%,1))
  210.     GOSUB FillDisplayRect
  211.      IF NOT flip% THEN CALL <0x1e,0x530d010>(VARPTR(flipRect%(0)))
  212.     'calculate landing spot
  213.     'first adjust for lie
  214.     IF Terrain%=1 THEN lie=1 : IF Terrain%=2 THEN lie=0.9 : IF Terrain%=3 THEN lie=0.8
  215.     IF Terrain%=4 AND loft%(club%)< 5 THEN lie=0.5 :ELSE IF Terrain%=4 AND loft%(club%)> 4 THEN lie=0.75
  216.     IF Terrain%=7 AND loft%(club%)>4 THEN lie=0.5 :ELSE IF Terrain%=7 AND loft%(club%)< 5 THEN lie=0.9
  217.      rAim=3.14/180*(Aim%+(sink%*skill%*2))
  218.     nx%=BallX%+((MaxDist%(club%)*(hit%/100)*lie)*SIN(rAim)/4)
  219.     ny%=BallY%-((MaxDist%(club%)*(hit%/100)*lie)*COS(rAim)/4)
  220.     IF nx%<352 THEN nx%=354 :ELSE IF nx% >508 THEN nx%=504
  221.     IF ny%<8 THEN ny%=10 :ELSE IF ny%>216 THEN ny%=214
  222.     IF (ny%<>BallY%) THEN sy%=(ny%-BallY%)/ABS((ny%-BallY%))
  223.     IF (nx%<>BallX%) THEN sx%=(nx%-BallX%)/ABS((nx%-BallX%))
  224.     tx%=BallX% : ty%=BallY%
  225.     nm%=ABS(ny%-ty%)+ABS(tx%-nx%)
  226.     mm%=nm%/2 : cm%=0 : alt%=0
  227.     WHILE (ty% <> ny%) OR (tx% <> nx%)
  228.         IF cm%<mm%+1 THEN cm%=cm%+1 : alt%=alt%+loft%(club%)
  229.         IF cm%>mm% THEN alt%=alt%-loft%(club%)
  230.         CALL <0x13,0x530d010>(VARPTR(flipRect%(0)))
  231.         IF (tx% <> nx%) THEN tx%=tx%+sx%
  232.         IF (ty% <> ny%) THEN ty%=ty%+sy%
  233.         SetRect flipRect%(0),tx%-2,ty%-2,tx%+2,ty%+2
  234.         x%=INT((tx%-352)/8)
  235.         y%=INT((ty%-2)/8)
  236.         Terrain%=ASC(MID$(Hole$,(x%-1)*26+y%,1))
  237.         IF Terrain%=6 THEN
  238.             IF alt%>10 AND alt%<45 THEN
  239.             'Hit a Tree!
  240.                 SOUND 255,0.55,250
  241.                 CALL <0x13,0x530d010>(VARPTR(flipRect%(0)))
  242.                 rAim=3.14/180*(RND*360)
  243.                 nx%=tx%+(tx%-nx%)*SIN(rAim)/4
  244.                 ny%=ty%-(ty%-ny%)*COS(rAim)/4
  245.                 IF (ny%<>ty%) THEN sy%=(ny%-ty%)/ABS((ny%-ty%))
  246.                 IF (nx%<>tx%) THEN sx%=(nx%-tx%)/ABS((nx%-tx%))
  247.                 WHILE (nx%<>tx%) OR (ny%<>ty%) 
  248.                     CALL <0x13,0x530d010>(VARPTR(flipRect%(0)))
  249.                     IF (tx% <> nx%) THEN tx%=tx%+sx%
  250.                     IF (ty% <> ny%) THEN ty%=ty%+sy%
  251.                     SetRect flipRect%(0),tx%-2,ty%-2,tx%+2,ty%+2
  252.                     CALL <0x13,0x530d010>(VARPTR(flipRect%(0)))
  253.             WEND
  254.             END IF
  255.         END IF
  256.         CALL <0x13,0x530d010>(VARPTR(flipRect%(0)))
  257.     WEND
  258.    GOSUB CheckValidLanding
  259.     BallX%=nx% : BallY%=ny%
  260.     OldView%=0
  261.     CALL <0x13,0x530d010>(VARPTR(flipRect%(0)))
  262.     SetRect flipRect%(0),BallX%-2,BallY%-2,BallX%+2,BallY%+2
  263.     CALL <0x13,0x530d010>(VARPTR(flipRect%(0)))
  264.     x%=INT((BallX%-352)/8)-1
  265.     y%=INT((BallY%-2)/8)
  266.     IF x%=gdx1% AND y%=gdy% THEN GOSUB PutOut
  267.     IF x%=gdx2% AND y%=gdy% THEN GOSUB PutOut
  268.     IF x%=gdx1% AND y%=gdy%+1 THEN GOSUB PutOut
  269.     IF x%=gdx2% AND y%=gdy%+1 THEN GOSUB PutOut
  270.     GOSUB DrawView
  271.     GOSUB ShowDistance
  272.     CALL <0x1f,0x530d010>(VARPTR(HitRect1%(0)),VARPTR(white%(0)))
  273.     flip%=-1
  274. RETURN
  275.  
  276. CheckValidLanding:
  277.     invalid%=0
  278.     tx%=INT((nx%-352)/8)-1
  279.     ty%=INT((ny%-2)/8)
  280.     Terrain%=ASC(MID$(Hole$,(tx%-1)*26+ty%,1))
  281.     IF Terrain%=8 OR Terrain%=5 THEN invalid%=-1
  282.     IF Terrain%=8 THEN invalid$="The ball has gone out of bounds."+CHR$(13)+CHR$(13)
  283.     IF Terrain%=5 THEN invalid$="The ball has landed in water."+CHR$(13)+CHR$(13)
  284.     invalid$=invalid$+"A one stroke penalty will be assessed." +CHR$(13)+CHR$(13)+"You must hit over."
  285.     IF invalid% THEN
  286.         WINDOW 2,"",(140,50)-(320,190),-2
  287.         <0x40,0x530d010> 1,1,"OK",(40,110)-(140,130),1
  288.         SetRect tbRect%(0),10,10,170,100
  289.         TextBox invalid$,tbRect%(0),1
  290.         d%=0 : b%=0
  291.         WHILE d%<> 1
  292.             d%=<0x43,0x530d010>(0)
  293.             b%=<0x43,0x530d010>(1)
  294.         WEND
  295.         WINDOW CLOSE 2
  296.         nx%=BallX% : ny%=BallY%
  297.         Stroke%=Stroke%+1
  298.     END IF
  299. RETURN
  300.             
  301. 'print stroke and distance
  302. ShowDistance:
  303.     CALL <0x0a,0x530d010>(12)
  304.     LOCATE 13,16 : PRINT SPACE$(56) : LOCATE 13,16
  305.     PRINT "Hole:";Hole%;
  306.     PRINT "Stroke:";Stroke%;
  307.     dx=GreenRect%(1)+7-BallX%:dy=GreenRect%(0)+7-BallY%
  308.     dis%=SQR(dx^2+dy^2)*4
  309.     PRINT "Dist.:";dis%;"Yds"
  310.     CALL <0x09,0x530d010>(9)
  311. RETURN
  312.     
  313. ChooseClub:
  314.     linenum%=top%+(msPt%(0)-scr%(0))\19
  315.     'calculate line of array clicked on
  316.     top%=0
  317.     ScrollText s!,scr%(0),s$(0),top%,15,linenum%,4
  318.     'linenum% is highlighted with this redraw
  319.     club%=linenum%
  320.     WHILE MOUSE(0)<>0:WEND
  321.         'wait for mouse up
  322. RETURN 
  323.  
  324. 'change direction of shot & show appropriate view
  325. SetAim:
  326.     angle%=Aim%
  327.     rAim=3.14/180*Aim%
  328.     LINE(63,173)-(63+(35*SIN(rAim)),173-(35*COS(rAim))),30
  329.     PtToAngle DirRect%(0),msPt%(0),Aim%
  330.     rAim=3.14/180*Aim%
  331.     LINE(63,173)-(63+(35*SIN(rAim)),173-(35*COS(rAim))),33
  332.     WHILE MOUSE(0)<>0:WEND
  333.     'wait for mouse up
  334.     LOCATE 18,3:PRINT "         "
  335.     LOCATE 18,3:PRINT STR$(Aim%)+"°"
  336.     IF NOT OnGreen% THEN GOSUB DrawView
  337. RETURN
  338.  
  339. DrawPlayField:
  340.     WINDOW 1,,(0,20)-(512,342),4
  341.     SetRect MapRect%(0),364,14,499,213
  342.     SetRect DispRect%(0,1),130,156,330,180
  343.     SetRect DispRect%(0,2),130,140,196,156
  344.     SetRect DispRect%(0,3),196,140,263,156
  345.     SetRect DispRect%(0,4),263,140,330,156
  346.     SetRect DispRect%(0,5),130,128,170,140
  347.     SetRect DispRect%(0,6),170,128,210,140
  348.     SetRect DispRect%(0,7),210,128,250,140
  349.     SetRect DispRect%(0,8),250,128,290,140
  350.     SetRect DispRect%(0,9),290,128,330,140
  351.     SetRect DispRect%(0,10),130,120,158,128
  352.     SetRect DispRect%(0,11),158,120,187,128
  353.     SetRect DispRect%(0,12),187,120,216,128
  354.     SetRect DispRect%(0,13),216,120,245,128
  355.     SetRect DispRect%(0,14),245,120,274,128
  356.     SetRect DispRect%(0,15),274,120,305,128
  357.     SetRect DispRect%(0,16),305,120,330,128
  358.     SetRect DispRect%(0,17),130,116,152,120
  359.     SetRect DispRect%(0,18),152,116,174,120
  360.     SetRect DispRect%(0,19),174,116,196,120
  361.     SetRect DispRect%(0,20),196,116,218,120
  362.     SetRect DispRect%(0,21),218,116,240,120
  363.     SetRect DispRect%(0,22),230,116,262,120
  364.     SetRect DispRect%(0,23),252,116,284,120
  365.     SetRect DispRect%(0,24),274,116,306,120
  366.     SetRect DispRect%(0,25),306,116,330,120
  367.     LINE(0,0)-(512,342),33,bf
  368.     LINE(9,9)-(351,218),30,bf
  369.     LINE(359,9)-(504,218),30,bf
  370.     LINE(9,224)-(504,321),30,bf
  371.     LINE(128,18)-(332,182),33,b
  372.     CALL <0x0a,0x530d010>(9) 
  373.     LOCATE 20,3:PRINT "HOLE   :"
  374.     LOCATE 21,3:PRINT "PAR    :"
  375.     LOCATE 22,3:PRINT "YARDS:"
  376.     LOCATE 23,3:PRINT"SCORE:"
  377.     totpar%=0 : totdis%=0
  378.     FOR a% = 1 TO 18
  379.         LOCATE 20,a%*4+7:PRINT a%
  380.         GET #1,a%
  381.         GreenX%=ASC(GreenX$)*8+360:GreenY%=ASC(GreenY$)*8+2
  382.         TeeX%=ASC(TeeX$)*8+360:TeeY%=ASC(TeeY$)*8+2
  383.         SetRect GreenRect%(0),GreenX%,GreenY%,GreenX%+15,GreenY%+15
  384.         SetRect TeeRect%(0),TeeX%,TeeY%,TeeX%+15,TeeY%+15
  385.         dx=GreenRect%(1)-TeeRect%(1):dy=GreenRect%(0)-TeeRect%(0)
  386.         dis%=SQR(dx^2+dy^2)*4
  387.         par%=3
  388.         IF dis%>250 THEN par%=4
  389.         IF dis%>500 THEN par%=5
  390.         LOCATE 21,a%*4+7:PRINT par%
  391.         LOCATE 22,a%*4+7:PRINT dis%
  392.         totdis%=totdis%+dis% : totpar%=totpar%+par%
  393.     NEXT a%
  394.     LOCATE 24,20 : PRINT "Par for Course:";totpar%,"Course DIstance:";totdis%
  395.     LINE (1,276)-(511,276)
  396.     FOR a%=1 TO Hole% -1
  397.         LOCATE 24,a%*4+7:PRINT HoleScore%(a%)
  398.     NEXT a%
  399.     LINE(19,19)-(36,121),33,b
  400.     SetRect HitRect1%(0),20,20,36,120
  401.     SetRect HitRect2%(0),20,120,36,120
  402.     LINE(15,40)-(40,40)
  403.     LINE(15,100)-(40,100)
  404.     CALL <0x1f,0x530d010>(VARPTR(HitRect1%(0)),VARPTR(white%(0)))
  405.     <0x40,0x530d010> 1,1,"Hit",(50,100)-(110,120),1
  406.     linenum%=0 : top%=0 : s!=0 : in%=0
  407.     SetRect scr%(0),50,20,95,90
  408.     SetRect bar%(0),94,20,110,90
  409.     <0x532210e,0x530d010> VARPTR(scr%(0))
  410.     NewScroll s!,bar%(0),1,1,10,1
  411.     RESTORE ClubNames
  412.     FOR n=0 TO 14: READ n$:s$(n)=n$:NEXT n
  413.     ScrollText s!,scr%(0),s$(0),top%,15,1,4
  414.     club%=1
  415.     SetRect DirRect%(0),25,135,101,211
  416.     CALL <0x0b,0x530d010>(2,2)
  417.     CALL <0x13,0x530d010>(VARPTR(DirRect%(0)))
  418.     CALL <0x0b,0x530d010>(1,1)
  419.     LINE(63,173)-(63,137)
  420.     Aim%=0
  421.     LOCATE 18,3:PRINT "         "
  422.     LOCATE 18,3:PRINT STR$(Aim%)+"°"
  423.     MENU 1,0,1
  424.     MENU 1,1,0
  425.     MENU 1,2,0
  426.     MENU 1,3,1
  427. RETURN
  428.  
  429. GetHole:
  430.     GET #1,Hole%
  431.     GreenX%=ASC(GreenX$)*8+360:GreenY%=ASC(GreenY$)*8+2
  432.     TeeX%=ASC(TeeX$)*8+360:TeeY%=ASC(TeeY$)*8+2
  433.     Hole$=HoleMap$ 
  434.     SetRect GreenRect%(0),GreenX%,GreenY%,GreenX%+15,GreenY%+15
  435.     SetRect TeeRect%(0),TeeX%,TeeY%,TeeX%+15,TeeY%+15
  436.     BallY%=TeeRect%(0)+7:BallX%=TeeRect%(1)+7
  437.     dx=GreenRect%(1)-TeeRect%(1):dy=GreenRect%(0)-TeeRect%(0)
  438.     dis%=SQR(dx^2+dy^2)*4
  439.     gdx1%=ASC(GreenX$) : gdx2%=ASC(GreenX$)+1 : gdy%=ASC(GreenY$)
  440.     LINE(130,20)-(330,180),30,bf
  441.     LINE(140,30)-(320,100),33,b
  442.     LINE(220,100)-(240,170),33,b
  443.     LINE(135,170)-(325,170)
  444.     CALL <0x0a,0x530d010>(12)
  445.     CALL <0x09,0x530d010>(1)
  446.     LOCATE 4,18 : PRINT "Loading Hole:";Hole%
  447.     LOCATE 5,18:PRINT "Length:";dis%;"Yards"
  448.     CALL <0x09,0x530d010>(0)
  449.     CALL <0x09,0x530d010>(9)
  450.     GOSUB DrawHole
  451.     SetRect flipRect%(0),TeeRect%(1)+5,TeeRect%(0)+5,TeeRect%(1)+11,TeeRect%(0)+11
  452.     CALL <0x13,0x530d010>(VARPTR(flipRect%(0)))
  453.     Stroke%=1:flip%=-1
  454.     GOSUB ShowDistance
  455.     OnGreen%=0
  456. RETURN
  457.  
  458. DrawHole: 
  459.     CALL <0x1f,0x530d010>(VARPTR(MapRect%(0)),VARPTR(white%(0)))
  460.     FOR x%=1 TO 18
  461.         FOR y%=1 TO 26
  462.             SetRect UtilRect%(0),x%*8+352,y%*8+2,x%*8+360,y%*8+10
  463.             Terrain$=MID$(Hole$,(x%-1)*26+y%,1)
  464.             Terrain%=ASC(Terrain$)
  465.             IF Terrain%=1 THEN CALL <0x2a,0x530d010>(VARPTR(UtilRect%(0)),VARPTR(fair%(0)))
  466.             IF Terrain%=2 THEN CALL <0x2a,0x530d010>(VARPTR(UtilRect%(0)),VARPTR(Rough%(0)))
  467.             IF Terrain%=3 THEN CALL <0x2a,0x530d010>(VARPTR(UtilRect%(0)),VARPTR(HiRough%(0)))
  468.             IF Terrain%=4 THEN CALL <0x2a,0x530d010>(VARPTR(UtilRect%(0)),VARPTR(Sand%(0)))
  469.             IF Terrain%=5 THEN CALL <0x2a,0x530d010>(VARPTR(UtilRect%(0)),VARPTR(Water%(0)))
  470.             IF Terrain%=6 THEN CALL <0x2a,0x530d010>(VARPTR(UtilRect%(0)),VARPTR(Trees%(0)))
  471.             IF Terrain%=7 THEN CALL <0x2a,0x530d010>(VARPTR(UtilRect%(0)),VARPTR(Shrubs%(0)))
  472.             IF Terrain%=8 THEN CALL <0x2a,0x530d010>(VARPTR(UtilRect%(0)),VARPTR(bounds%(0)))
  473.         NEXT y%
  474.     NEXT x%
  475.     PUT (GreenX%,GreenY%)-(GreenX%+15,GreenY%+15),green%(0),PSET
  476.     PUT (TeeX%,TeeY%)-(TeeX%+15,TeeY%+15),Tee%(0),PSET
  477.     OldView%=0
  478.     GOSUB DrawView
  479. RETURN
  480.  
  481. DrawView:
  482.     IF Aim%<46 OR Aim%>315 THEN NewView%=1
  483.     IF Aim%<136 AND Aim%>45 THEN NewView%=2
  484.     IF Aim%<226 AND Aim%>135 THEN NewView%=3
  485.     IF Aim%<316 AND Aim%>225 THEN NewView%=4
  486.     IF NewView% = OldView% THEN RETURN
  487.     OldView% = NewView%
  488.     IF NewView%=1 THEN RESTORE NorthView
  489.     IF NewView%=2 THEN RESTORE EastView
  490.     IF NewView%=3 THEN RESTORE SouthView
  491.     IF NewView%=4 THEN RESTORE WestView
  492.     SetRect ViewRect%(0),130,20,330,180
  493.     ClipRect ViewRect%(0)
  494.     LINE(130,20)-(330,180),30,bf
  495.     x%=INT((BallX%-352)/8)-1
  496.     y%=INT((BallY%-2)/8)
  497.     FOR a%=1 TO 25 : READ deltax%(a%),deltay%(a%) : NEXT a%
  498.     FOR a%=25 TO 1 STEP -1
  499.         dx%=deltax%(a%)+x% : dy%=deltay%(a%)+y%
  500.         IF dx%>0 AND dx%<18 THEN
  501.             IF dy%>0 AND dy%<27 THEN
  502.                 Terrain%=ASC(MID$(Hole$,(dx%)*26+dy%,1))
  503.             END IF
  504.         END IF
  505.         IF dx%<1 OR dx%>18 THEN Terrain%=8
  506.         IF dy%<1 OR dy%>26 THEN Terrain%=8
  507.         GOSUB FillDisplayRect
  508.     NEXT a%
  509.     FOR a%=1 TO 25
  510.         dx%=deltax%(a%)+x% : dy%=deltay%(a%)+y%
  511.         IF dx%=gdx1% AND dy%=gdy% THEN
  512.             w%=(DispRect%(3,a%)-DispRect%(1,a%))*2
  513.             h%=(DispRect%(2,a%)-DispRect%(0,a%))
  514.             IF NewView%<>3 THEN SetRect UtilRect%(0),DispRect%(1,a%),DispRect%(0,a%),DispRect%(3,a%)+w%,DispRect%(2,a%)+h%
  515.             IF NewView%=3 THEN  SetRect UtilRect%(0),DispRect%(1,a%)-w%,DispRect%(0,a%),DispRect%(3,a%),DispRect%(2,a%)+h%
  516.             CALL <0x1f,0x530d010>(VARPTR(UtilRect%(0)),VARPTR(white%(0)))
  517.             CALL <0x13,0x530d010>(VARPTR(UtilRect%(0)))
  518.             GOSUB DrawFlag
  519.             dx%=99 : a%=25
  520.         END IF
  521.         IF dx%=gdx2% AND dy%=gdy% THEN
  522.             w%=(DispRect%(3,a%)-DispRect%(1,a%))*2
  523.             h%=(DispRect%(2,a%)-DispRect%(0,a%))
  524.             IF NewView%=3 THEN SetRect UtilRect%(0),DispRect%(1,a%),DispRect%(0,a%),DispRect%(3,a%)+w%,DispRect%(2,a%)+h%
  525.             IF NewView%<>3 THEN  SetRect UtilRect%(0),DispRect%(1,a%)-w%,DispRect%(0,a%),DispRect%(3,a%),DispRect%(2,a%)+h%
  526.             CALL <0x1f,0x530d010>(VARPTR(UtilRect%(0)),VARPTR(white%(0)))
  527.             CALL <0x13,0x530d010>(VARPTR(UtilRect%(0)))
  528.             GOSUB DrawFlag
  529.             dx%=99 : a%=25
  530.         END IF
  531.     NEXT a%
  532.     READ View$
  533.     CALL <0x0a,0x530d010>(12)
  534.     LOCATE 3,25:PRINT View$
  535.     CALL <0x09,0x530d010>(9)
  536.     SetRect BallRect%(0),225,165,235,175
  537.     CALL <0x1f,0x530d010>(VARPTR(BallRect%(0)),VARPTR(white%(0)))
  538.     CALL <0x13,0x530d010>(VARPTR(BallRect%(0)))
  539.     SetRect ViewRect%(0),0,0,512,342
  540.     ClipRect ViewRect%(0)
  541. RETURN
  542.  
  543. DrawFlag:
  544.     midx%=(UtilRect%(1)+UtilRect%(3))/2
  545.     midy%=(UtilRect%(0)+UtilRect%(2))/2
  546.     h%=UtilRect%(2)-UtilRect%(0)
  547.     LINE(midx%,midy%)-(midx%,midy%-h%)
  548.     LINE(midx%,midy%-h%)-(midx%-(h%/2),midy%-h%+(h%/4))
  549.     LINE(midx%-(h%/2),midy%-h%+(h%/4))-(midx%,midy%-h%+(h%/4))
  550. RETURN
  551.  
  552. FillDisplayRect:
  553.     IF Terrain%=1 THEN CALL <0x2f,0x530d010>(VARPTR(DispRect%(0,a%)),VARPTR(fair%(0)))
  554.     IF Terrain%=2 THEN CALL <0x2f,0x530d010>(VARPTR(DispRect%(0,a%)),VARPTR(Rough%(0)))
  555.     IF Terrain%=3 THEN CALL <0x2f,0x530d010>(VARPTR(DispRect%(0,a%)),VARPTR(HiRough%(0)))
  556.     IF Terrain%=4 THEN CALL <0x2f,0x530d010>(VARPTR(DispRect%(0,a%)),VARPTR(Sand%(0)))
  557.     IF Terrain%=5 THEN CALL <0x2f,0x530d010>(VARPTR(DispRect%(0,a%)),VARPTR(Water%(0)))
  558.     IF Terrain%=6 THEN 
  559.         CALL <0x24,0x530d010>(VARPTR(DispRect%(0,a%)),VARPTR(HiRough%(0)))
  560.         Diff%=(DispRect%(2,a%)-DispRect%(0,a%))*6
  561.         PUT (DispRect%(1,a%),DispRect%(2,a%)-Diff%)-(DispRect%(3,a%),DispRect%(2,a%)),TreeICON%(0),OR
  562.     END IF
  563.     IF Terrain%=7 THEN
  564.         CALL <0x24,0x530d010>(VARPTR(DispRect%(0,a%)),VARPTR(Rough%(0)))
  565.         Diff%=(DispRect%(2,a%)-DispRect%(0,a%))*3
  566.         PUT (DispRect%(1,a%),DispRect%(2,a%)-Diff%)-(DispRect%(3,a%),DispRect%(2,a%)),ShrubICON%(0),OR
  567.     END IF
  568.     IF Terrain%=8 THEN CALL <0x2f,0x530d010>(VARPTR(DispRect%(0,a%)),VARPTR(bounds%(0)))
  569. RETURN 
  570.  
  571. PutOut:
  572.     dx=GreenRect%(1)+7-BallX%:dy=GreenRect%(0)+7-BallY%
  573.     dis%=SQR(dx^2+dy^2)*12
  574.     OnGreen%=-1
  575.     LINE(130,20)-(330,180),30,bf
  576.     SetRect UtilRect%(0),130,20,330,180
  577.     SetRect CupRect%(0),225,95,235,105
  578.     CALL <0x1f,0x530d010>(VARPTR(UtilRect%(0)),VARPTR(fair%(0)))
  579.     CALL <0x1f,0x530d010>(VARPTR(UtilRect%(0)),VARPTR(white%(0)))
  580.     CALL <0x13,0x530d010>(VARPTR(UtilRect%(0)))
  581.     CALL <0x1f,0x530d010>(VARPTR(CupRect%(0)),VARPTR(bounds%(0)))
  582.     InsetRect CutRect%(0),2,2
  583.     BallX%=228 : BallY%=100+(dis%/2)
  584.     SetRect UtilRect%(0),BallX%,BallY%,BallX%+4,BallY%+4
  585.     GOSUB ShowPutDistance
  586.     CALL <0x13,0x530d010>(VARPTR(UtilRect%(0)))
  587.     MENU 1,0,0 : MENU 3,0,0
  588.     CALL <0x1f,0x530d010>(VARPTR(HitRect1%(0)),VARPTR(white%(0)))
  589.     PutOut%=0
  590.     WHILE NOT PutOut%
  591.         ms%=MOUSE(0)
  592.         d%=<0x43,0x530d010>(0):b%=<0x43,0x07>(1)
  593.         IF d%=1 AND b%=1 THEN GOSUB HitPut
  594.         IF ms%=1 THEN
  595.             GetMouse msPt%(0)
  596.             PtInRect msPt%(0),DirRect%(0),in%
  597.             IF in% THEN GOSUB SetAim
  598.         END IF
  599.     WEND
  600.     Hole%=Hole%+1
  601.     IF Hole%=19 THEN EndRound
  602.     GOSUB GetHole
  603.     Terrain%=1
  604.     MENU 1,0,1 : MENU 3,0,1
  605. RETURN
  606.  
  607. HitPut:
  608.     Stroke%=Stroke%+1
  609.     SetRect HitRect2%(0),20,120,36,120
  610.     d%=0 : b%=0 : hit%=0
  611.     WHILE hit%<100 AND d%<>1
  612.         d%=<0x43,0x530d010>(0)
  613.         b%=<0x43,0x530d010>(1)
  614.         hit%=hit%+1
  615.         LINE (20,120-hit%)-(36,120),33,bf
  616.         IF d%=1 AND b%<>1 THEN d%=0
  617.     WEND
  618.      SetRect HitRect2%(0),20,120-hit%,36,120-hit%
  619.     sink%=120-hit% : d%=0 : b%=0
  620.     IF hit%>20 THEN
  621.         WHILE sink%<120 AND d%<>1
  622.             d%=<0x43,0x530d010>(0)
  623.             b%=<0x43,0x530d010>(1)
  624.             sink%=sink%+1
  625.             SetRect HitRect2%(0),20,120-hit%,36,sink%
  626.             CALL <0x1f,0x530d010>(VARPTR(HitRect2%(0)),VARPTR(fair%(0)))
  627.             IF d%=1 AND b%<>1 THEN d%=0
  628.         WEND
  629.     END IF
  630.     IF hit%<21 THEN
  631.         sink%=100
  632.         WHILE d%<>1
  633.             d%=<0x43,0x530d010>(0)
  634.         WEND
  635.     END IF
  636.     sink%=100-sink%
  637.     SOUND 710,0.5,200
  638.     Terrain%=ASC(MID$(Hole$,(x%-1)*26+y%,1))
  639.      rAim=3.14/180*(Aim%+(sink%*skill%*2))
  640.     nx%=BallX%+(hit%*SIN(rAim))
  641.     ny%=BallY%-(hit%*COS(rAim))
  642.     IF ny%< 21 THEN ny%=21 :ELSE IF ny%>179 THEN ny%=179
  643.     IF nx%<131 THEN nx%=131 :ELSE IF nx%>329 THEN nx%=329
  644.     IF (ny%<>BallY%) THEN sy%=(ny%-BallY%)/ABS((ny%-BallY%))
  645.     IF (nx%<>BallX%) THEN sx%=(nx%-BallX%)/ABS((nx%-BallX%))
  646.     tx%=BallX% : ty%=BallY%
  647.     WHILE (ty% <> ny%) OR (tx% <> nx%) 
  648.         CALL <0x13,0x530d010>(VARPTR(UtilRect%(0)))
  649.         IF (tx% <> nx%) THEN tx%=tx%+sx%
  650.         IF (ty% <> ny%) THEN ty%=ty%+sy%
  651.         SetRect UtilRect%(0),tx%-2,ty%-2,tx%+2,ty%+2
  652.         CALL <0x13,0x530d010>(VARPTR(UtilRect%(0)))
  653.     WEND
  654.     BallX%=nx% : BallY%=ny%
  655.     CALL <0x1f,0x530d010>(VARPTR(HitRect1%(0)),VARPTR(white%(0)))
  656.     msPt%(0)=ny% : msPt%(1)=nx%
  657.     PtInRect msPt%(0),CupRect%(0),in%
  658.     IF in% THEN 
  659.         PutOut%=-1
  660.         CALL <0x13,0x530d010>(VARPTR(UtilRect%(0)))
  661.         SOUND 210,0.5,200 : SOUND 150,0.3,150 : SOUND 110,0.15,100
  662.         LOCATE 23,Hole%*4+7 : PRINT Stroke%-1
  663.         HoleScore%(Hole%)=Stroke%-1
  664.     END IF 
  665.     IF NOT PutOut% THEN ShowPutDistance
  666. RETURN
  667.  
  668. ShowPutDistance:
  669.     CALL <0x0a,0x530d010>(12)
  670.     LOCATE 13,16 : PRINT SPACE$(56) : LOCATE 13,16
  671.     PRINT "Hole:";Hole%;
  672.     PRINT "Stroke:";Stroke%;
  673.     dx=230-BallX%:dy=100-BallY%
  674.     dis%=SQR(dx^2+dy^2)/3
  675.     PRINT "Dist.:";dis%;"ft"
  676.     CALL <0x09,0x530d010>(9)
  677. RETURN
  678.  
  679. SetSkill:
  680.     FOR a%=1 TO 3: MENU 3,a%,1:NEXT a%
  681.     MENU 3,i%,2
  682.     skill%=a%
  683. RETURN
  684.  
  685. EndRound:
  686.     CALL <0x0a,0x530d010>(12)
  687.     CALL <0x09,0x530d010>(1)
  688.     LOCATE 20,3
  689.     i%=0
  690.     FOR a%=1 TO 18 : i%=i%+HoleScore%(a%) : NEXT a%
  691.     PRINT "Total Score:";i%
  692.     <0x40,0x530d010> 2,1,"Off to the 19th Hole!",(350,300)-(500,320),1
  693.     d%=0 : b%=0
  694.     WHILE d%<>1 OR b%<>2
  695.         d%=<0x43,0x530d010>(0)
  696.         b%=<0x43,0x530d010>(1)
  697.     WEND
  698.     WINDOW CLOSE 1
  699.     END
  700.     
  701. IconData:
  702. '  Data for ICON: Green
  703. DATA 16,16,-20486,20485,-24350,16625
  704. DATA-32543,-32639,-32639,-32319,-32095
  705. DATA-32223,-32319,-32767,-32766,16389
  706. DATA-24566,24565
  707. '  Data for ICON: tee
  708. DATA 16,16,-21846, 21845,-16386,24581
  709. DATA-24570,24581,-24570,27701,-21450
  710. DATA 24581,-24570,24581,-24570,32765
  711. DATA-21846,21845
  712. '  Data for ICON: Tree
  713. DATA 32 , 32 , 0 , 0 , 1 , 0 , 3 ,-32768 , 2 ,-16384
  714. DATA 7 ,-24576 , 5 ,-8192 , 15 , 20480 , 31 ,-4096 , 31 ,-2048
  715. DATA 55 ,-1024 , 63 ,-512 , 127 ,-256 , 255 ,-3072 , 1022 ,-512
  716. DATA 379 ,-128 , 255 ,-64 , 1023 ,-160 , 1535 ,-512 , 511 ,-512
  717. DATA 1791 ,-768 , 2559 ,-128 , 1015 ,-576 , 2047 ,-2368 , 3327 ,-416
  718. DATA 4606 ,-24800 , 1911 ,-30848 , 8071 ,-32576 , 12294 ,-32672 , 7 ,-32752
  719. DATA 7 ,-32768 , 7 ,-32768 , 15 ,-16384
  720. '  Data for ICON: Shrub
  721. DATA 32 , 32 , 0 , 0 , 0 , 0 , 0 , 0 , 15 , 0
  722. DATA 63 ,-2048 , 247 ,-16896 , 447 ,-128 , 1019 ,-64 , 2047 ,-2144
  723. DATA 4031 ,-16 , 7166 ,-16 , 8191 ,-8 , 15855 ,-8328 , 32767 ,-4
  724. DATA 32767 ,-1044 , 24574 ,-4 , 32511 ,-2 , 31711 ,-8194 , 16383 ,-66
  725. DATA 16381 ,-522 , 6143 ,-8196 , 8127 ,-4 , 3839 ,-16392 , 2030 ,-528
  726. DATA 1023 ,-64 , 255 ,-16512 , 3 ,-4096 , 1 ,-24576 , 1 ,-24576
  727. DATA 1 ,-8192 , 1 , 24576 , 3 ,-4096
  728.  
  729. ClubNames:
  730. DATA "Driver","2 Wood","3 Wood","4 Wood"
  731. DATA "1 Iron","2 Iron","3 Iron","4 Iron","5 Iron","6 Iron","7 Iron","8 Iron","9 Iron"
  732. DATA "P. Wedge","S. Wedge"
  733.  
  734. ClubData:
  735. 'Maximum distance data
  736. DATA 300,250,220,200
  737. DATA 205,195,185,175,165,155,145,135,125
  738. DATA 100,80
  739. 'Loft data
  740. DATA 1,2,4,5
  741. DATA 1,2,3,4,5,6,7,8,9
  742. DATA 10,11
  743.  
  744. NorthView:
  745.     DATA  0,0
  746.     DATA -1,-1,0,-1,1,-1
  747.     DATA -2,-2,-1,-2,0,-2,1,-2,2,-2
  748.     DATA -3,-3,-2,-3,-1,-3,0,-3,1,-3,2,-3,3,-3
  749.     DATA -4,-4,-3,-4,-2,-4,-1,-4,0,-4,1,-4,2,-4,3,-4,4,-4
  750.     DATA "North View"
  751.  
  752. EastView:
  753.     DATA 0,0
  754.     DATA 1,-1,1,0,1,1
  755.     DATA 2,-2,2,-1,2,0,2,1,2,2
  756.     DATA 3,-3,3,-2,3,-1,3,0,3,1,3,2,3,3
  757.     DATA 4,-4,4,-3,4,-2,4,-1,4,0,4,1,4,2,4,3,4,4
  758.     DATA "East View"
  759.     
  760. SouthView:
  761.     DATA 0,0
  762.     DATA 1,1,0,1,-1,1
  763.     DATA 2,2,1,2,0,2,-1,2,-2,2
  764.     DATA 3,3,2,3,1,3,0,3,-1,3,-2,3,-3,3
  765.     DATA 4,4,3,4,2,4,1,4,0,4,-1,4,-2,4,-3,4,-4,4
  766.     DATA "South View"
  767.  
  768. WestView:
  769.     DATA 0,0
  770.     DATA -1,1,-1,0,-1,-1
  771.     DATA -2,2,-2,1,-2,0,-2,-1,-2,-2
  772.     DATA -3,3,-3,2,-3,1,-3,0,-3,-1,-3,-2,-3,-3
  773.     DATA -4,4,-4,3,-4,2,-4,1,-4,0,-4,-1,-4,-2,-4,-3,-4,-4
  774.     DATA "West View"
  775.     
  776.